! (C) Copyright 2000- ECMWF.
! (C) Copyright 2000- Meteo-France.
! 
! This software is licensed under the terms of the Apache Licence Version 2.0
! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0.
! In applying this licence, ECMWF does not waive the privileges and immunities
! granted to it by virtue of its status as an intergovernmental organisation
! nor does it submit to any jurisdiction.
!

MODULE FSPGL_INT_MOD_dp
CONTAINS
SUBROUTINE FSPGL_INT(KM,KMLOC,KF_UV,KF_SCALARS,KF_SCDERS,KF_OUT_LT,&
 & FSPGL_PROC,KFLDPTRUV,KFLDPTRSC)

USE EC_PARKIND  ,ONLY : JPIM     ,JPRD

USE TPM_DIM         ,ONLY : R
USE TPM_TRANS_dp       ,ONLY : FOUBUF_IN, LDIVGP, LVORGP
USE TPM_GEOMETRY    ,ONLY : G
USE TPM_DISTR       ,ONLY : D
USE TPM_FIELDS      ,ONLY : F
USE ABORT_TRANS_MOD ,ONLY : ABORT_TRANS
!

IMPLICIT NONE

INTEGER(KIND=JPIM), INTENT(IN) :: KM
INTEGER(KIND=JPIM), INTENT(IN) :: KMLOC
INTEGER(KIND=JPIM), INTENT(IN) :: KF_UV,KF_SCALARS,KF_SCDERS,KF_OUT_LT
EXTERNAL  FSPGL_PROC
INTEGER(KIND=JPIM),OPTIONAL,INTENT(IN)  :: KFLDPTRUV(:)
INTEGER(KIND=JPIM),OPTIONAL,INTENT(IN)  :: KFLDPTRSC(:)

!
! ZFIELD 2nd dimension is extended from 0 to R%NDGL+1, while only 1 to R%NDGL
! is given from the north/south transforms, and only 1 to R%NDGL rows will be
! passed to the east/west transforms.
! the 2 extra rows are used inside the model Fourier space computations
! (outside the transform package - see FSPGLH in Arpege/IFS).
!
REAL(KIND=JPRD) :: ZFIELD(2*KF_OUT_LT,0:R%NDGL+1)


INTEGER(KIND=JPIM) :: ISL, IGLS, JFLD, JGL ,IPROC,  IPROCS
INTEGER(KIND=JPIM) :: IPTRU,IST,J
INTEGER(KIND=JPIM) :: IDGNH,IDGL
INTEGER(KIND=JPIM) :: ISTAN(R%NDGNH),ISTAS(R%NDGNH)
INTEGER(KIND=JPIM) :: IFLDPTRUV(KF_UV),IFLDPTRSC(KF_SCALARS)
!     ------------------------------------------------------------------

IF(PRESENT(KFLDPTRUV)) THEN
  IFLDPTRUV(:) = KFLDPTRUV(1:KF_UV)
  IFLDPTRSC(:) = KFLDPTRSC(1:KF_SCALARS)
ELSE
  DO J=1,KF_UV
    IFLDPTRUV(J) = J
  ENDDO
  DO J=1,KF_SCALARS
    IFLDPTRSC(J) = J
  ENDDO
ENDIF

ISL = MAX(R%NDGNH-G%NDGLU(KM)+1,1)
IDGNH = R%NDGNH
IDGL = R%NDGL
DO JGL=ISL,IDGNH
  IPROC = D%NPROCL(JGL)
  ISTAN(JGL) = (D%NSTAGT0B(IPROC) + D%NPNTGTB1(KMLOC,JGL))*2*KF_OUT_LT
  IGLS = IDGL+1-JGL
  IPROCS = D%NPROCL(IGLS)
  ISTAS(JGL) = (D%NSTAGT0B(IPROCS) + D%NPNTGTB1(KMLOC,IGLS))*2*KF_OUT_LT
ENDDO

DO JGL=ISL,IDGNH
  IGLS = IDGL+1-JGL
  DO JFLD=1,2*KF_OUT_LT
    ZFIELD(JFLD,JGL)  = FOUBUF_IN(ISTAN(JGL)+JFLD)
    ZFIELD(JFLD,IGLS) = FOUBUF_IN(ISTAS(JGL)+JFLD)
  ENDDO
ENDDO

IST = 1
IF(LVORGP) THEN
  IST = IST+2*KF_UV
ENDIF
IF(LDIVGP) THEN
  IST = IST+2*KF_UV
ENDIF
IPTRU = IST




CALL FSPGL_PROC(KM,ISL,IDGL,KF_OUT_LT,F%R1MU2,ZFIELD,&
 &   IPTRU,KF_UV,KF_SCALARS,&
 &   IFLDPTRUV)

DO JGL=ISL,IDGNH
  IGLS = IDGL+1-JGL
!OCL      NOVREC
  DO JFLD=1,2*KF_OUT_LT
    FOUBUF_IN(ISTAN(JGL)+JFLD) = ZFIELD(JFLD,JGL)
    FOUBUF_IN(ISTAS(JGL)+JFLD) = ZFIELD(JFLD,IGLS)
  ENDDO
ENDDO

!     ------------------------------------------------------------------

END SUBROUTINE FSPGL_INT
END MODULE FSPGL_INT_MOD_dp
